home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / p_mat.exe / MATTEST2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-12-09  |  6.6 KB  |  226 lines
  1. Program pt;
  2.  
  3. Uses pmat;
  4.  
  5. Procedure recursion;
  6. Var vv,a,b: vmatrixptr;
  7. Begin
  8.     new( vv, makematrix( 1, 1 ) );
  9.     new( a, makematrix( 1, 1 ) );
  10.     new( b, makematrix( 1, 1 ) );
  11.     vv := matequals( vv, inv( add( ident( 5 ), fill( 5, 5, 1 ) ) ) );
  12.     vv^.show( 'Inv(I+U)' );
  13.     
  14.     dispose( vv, killvmatrix );
  15.     dispose( a, killvmatrix );
  16.     dispose( b, killvmatrix );
  17. End;
  18. Procedure regression;
  19. Var x,y,data,beta,xpx : vmatrixptr;
  20. Begin
  21.     new( x, makematrix( 1, 1 ) );
  22.     new( y, makematrix( 1, 1 ) );
  23.     new( data, makematrix( 1, 1 ) );
  24.     new( beta, makematrix( 1, 1 ) );
  25.     new( xpx, makematrix( 1, 1 ) );
  26.     
  27.     data := matequals( data, reada( 'catchv.dat' ) );
  28.     y := matequals( y, submat( data, 1, data^.r, 1, 1 ) );
  29.     x := matequals( x, submat( data, 1, data^.r, 2, data^.c ) );
  30.     beta := matequals( beta, mult( inv( mult( tran( x ), x ) ), mult( tran( x ), y ) ) );
  31.     beta^.show( 'text book beta hat' );
  32.     
  33.     xpx := matequals( xpx, mult( tran( data ), data ) );
  34.     xpx := matequals( xpx, sweep( xpx, 2, xpx^.r ) );
  35.     beta := matequals( beta, submat( xpx, 2, xpx^.r, 1, 1 ) );
  36.     beta^.show( 'sweep beta hat' );
  37.     
  38.     dispose( x, killvmatrix );
  39.     dispose( y, killvmatrix );
  40.     dispose( data, killvmatrix );
  41.     dispose( beta, killvmatrix );
  42.     dispose( xpx, killvmatrix );
  43. End;
  44.  
  45. Procedure testIO;
  46. Var vv : vmatrixptr;
  47. Begin
  48.     new( vv, makematrix( 1, 1 ) );
  49.     vv := matequals( vv, reada( 'catchv.dat' ) );
  50.     vv^.show( 'catchv.dat' );
  51.     writea( 'junk.dat', vv , 'junk.dat' );
  52.     vv := matequals( vv, reada( 'junk.dat' ) );
  53.     vv^.show( 'junk.dat' );
  54.     dispose( vv, killvmatrix );
  55. End;
  56.  
  57. Procedure testElements;
  58. Var vv: vmatrixptr;
  59.     d : double;
  60.     i,j: integer;
  61. Begin
  62.     { note ^ must follow a call to mm, but not to m }
  63.     new( vv, makematrix( 5, 5 ) );
  64.     vv := matequals( vv, fill( 5, 5, 0 ) );
  65.     d := 0;
  66.     For i := 1 To vv^.r Do Begin 
  67.         For j := 1 To vv^.c Do Begin 
  68.             d := d + 1;
  69.             vv^.mm( i, j )^ := d;
  70.         End;
  71.     End;
  72.     vv^.mm( 3, 3 )^ := 3;
  73.     vv^.show( 'vv' );
  74.     writeln( '4,5 element of vv: ', vv^.m( 4, 5 ): 6: 2 );
  75.     dispose( vv, killvmatrix );
  76. End;
  77.  
  78. Procedure ObjectQuirk;
  79. Var vv : vmatrixptr;
  80.  Begin
  81.      new( vv, makematrix( 1, 1 ) );
  82.      fill( 3, 3, 1 )^.show( ' silly ' );
  83.      { weird but ok }
  84.      dispatch^.dumpstack;
  85.      vv := matequals( vv, fill( 5, 5, 3 ) );
  86.      {take the fill 3,3 off of stack}
  87.      dispatch^.dumpstack;              { using cleanstack in matequals}
  88.      vv^.show( 'vv' );
  89.      dispose( vv, killvmatrix );
  90.  End;
  91.  
  92. Procedure testleak( Var vv: vmatrixptr );
  93. Var ones,jj : vmatrixptr;
  94.     i : integer;
  95. Begin
  96.     {this function should cause a memory error if there is a leak}
  97.     dispatch^.inclevel;
  98.     writeln( 'this can take a while' );
  99.     writeln( 'MemAvail, MaxAvail 1 : ', memavail, ' ', maxavail );
  100.     new( ones, makematrix( 1, 1 ) );
  101.     new( jj, makematrix( 1, 1 ) );
  102.     ones := matequals( ones, fill( vv^.r, vv^.c, 1 ) );
  103.     jj := matequals( jj, vv );
  104.     For i := 1 To 1000 Do
  105.         jj := matequals( jj, add( jj, mult( tran( ones ), ones ) ) );
  106.     vv := matequals( vv, jj );
  107.     dispose( ones, killvmatrix );
  108.     dispose( jj, killvmatrix );
  109.     writeln( 'MemAvail, MaxAvail 2 : ', memavail, ' ', maxavail );
  110.     dispatch^.declevel;
  111. End;
  112.  
  113. Function testDecReturn: vmatrixptr;
  114. Var b: vmatrixptr;
  115. Begin
  116.     { use inclevel and decreturn if you use matequals in a function}
  117.     { also use inclevel-declevel in procedures that use matequals, or
  118.     in functions that use matequals but do not return vmatrixptr's.}
  119.     Dispatch^.Inclevel;
  120.     new( b, makematrix( 5, 5 ) );
  121.     b := matequals( b, Inv( add( Ident( 5 ), fill( 5, 5, 1 ) ) ) );
  122.     dispatch^.push( b );
  123.     testDecReturn := Dispatch^.decreturn;
  124. End;
  125.  
  126. Function testReturnMat: vmatrixptr;
  127. Var b: vmatrixptr;
  128.     i,j : integer;
  129.     d : double;
  130. Begin
  131.     { use returnmat if you do not use matequals in a function}
  132.     new( b, makematrix( 5, 5 ) );
  133.     d := 0;
  134.     For i := 1 To 5 Do
  135.         For j := 1 To 5 Do Begin 
  136.             d := d + 1;
  137.             b^.mm( i, j )^ := d;
  138.         End;
  139.     dispatch^.push( b );
  140.     testReturnMat := Dispatch^.ReturnMat;
  141. End;
  142.  
  143. Procedure testfuncts;
  144. Var i,u,v: vmatrixptr;
  145.     k : integer;
  146. Begin
  147.     new( i, makematrix( 5, 5 ) );
  148.     new( u, makematrix( 5, 5 ) );
  149.     new( v, makematrix( 5, 5 ) );
  150.     
  151.     i := matequals( i, Ident( 5 ) );
  152.     u := matequals( u, Fill( 5, 5, 1 ) );
  153.     
  154.     v := matequals( v, emult( i, u ) );
  155.     v^.show( 'I#U' );
  156.     v := matequals( v, neg( u ) );
  157.     v^.show( '-U' );
  158.     v := matequals( v, cv( i, u ) );
  159.     v^.show( 'i//v' );
  160.     v := matequals( v, ch( i, u ) );
  161.     v^.show( 'i||u' );
  162.     v := matequals( v, msqrt( add( i, u ) ) );
  163.     v^.show( 'sqrt(i+u)' );
  164.     v := matequals( v, fill( 5, 1, 0 ) );
  165.     For k := 1 To v^.r Do v^.mm( k, 1 )^ := k;
  166.     v := matequals( v, vecdiag( v ) );
  167.     v^.show( 'vecdiag(v)' );
  168.     v := matequals( v, fill( 1, 5, 0 ) );
  169.     For k := 1 To v^.c Do v^.mm( 1, k )^ := k;
  170.     v := matequals( v, vecdiag( v ) );
  171.     v^.show( 'vecdiag(v)' );
  172.     
  173.     
  174.     dispose( i, killvmatrix );
  175.     dispose( u, killvmatrix );
  176.     dispose( v, killvmatrix );
  177.     
  178. End;
  179. Procedure testPass( Var x: vmatrixptr );
  180. Begin
  181.     x := matequals( x, ident( 3 ) );
  182. End;
  183.  
  184.  
  185. {main}
  186. Var
  187.    vv, a, b: vmatrixptr;
  188.  Begin
  189.      new( vv, makematrix( 128, 128 ) );{make matrix > 64k}
  190.      vv^.infomatrix( 'vv' );
  191.      recursion;                        { test recursive calls }
  192.      regression;                       { test regression }
  193.      testIO;                           { test matrix io  }
  194.      testElements;                     { test element functions }
  195.  
  196.      { something I consider weird about OOP }
  197.      ObjectQuirk;
  198.  
  199.      { test for memory leak and var parameter passing }
  200.      vv := matequals( vv, fill( 5, 5, 0 ) );
  201.      testLeak( vv );
  202.      vv^.show( 'vv as a var parameter' );
  203.      
  204.      { show difference between DecReturn and ReturnMat }
  205.      vv := matequals( vv, testDecReturn );
  206.      vv^.show( 'vv from testDecReturn' );
  207.      vv := matequals( vv, testReturnMat );
  208.      vv^.show( 'vv from testReturnMat' );
  209.      
  210.      dispose( vv, killvmatrix );
  211.      vv^.infomatrix( 'vv after dispose' );
  212.      
  213.      { Test Matrix functions }
  214.      TestFuncts;
  215.      
  216.      testPass( vv );
  217.      vv^.show( 'after pass' );
  218.  
  219.      {$IFDEF DPMI}
  220.      writeln('make a matrix larger than 640k');
  221.      vv := matequals( vv, fill(300,300, 0 ) );
  222.      vv^.infomatrix('matrix larger than 640k');
  223.      {$ENDIF}
  224.  
  225.  End.
  226.